home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Applications / NIH Image 1.62b11 / Macros / Particle Analysis < prev    next >
Text File  |  1994-05-06  |  2KB  |  78 lines
  1. macro 'Particle Analysis Test';
  2. var
  3.   x,y,rows,columns,maxradius,radius:integer;
  4. begin
  5.   SaveState;
  6.   rows:=5; columns:=5;
  7.   maxradius:=rows*columns;
  8.   SetForegroundColor(255);
  9.   SetBackgroundColor(0);
  10.   SetNewSize(columns*maxradius*2+20,rows*maxradius*2+20);
  11.   MakeNewWindow('Objects');
  12.   radius:=1;
  13.   for y:=0 to columns-1 do
  14.     for x:=0 to rows-1 do begin
  15.       MakeOvalRoi(x*maxradius*2+10,y*maxradius*2+10,radius*2,radius*2);
  16.       Fill;
  17.       radius:=radius+1;
  18.     end;
  19.   KillRoi;
  20.   SetParticleSize(1,9999);
  21.   LabelParticles(true);
  22.   OutlineParticles(true);
  23.   SetOptions('Area, Perimeter, Major, Minor');
  24.   AnalyzeParticles;
  25.   SetUser1Label('Perim.d');
  26.   SetUser2Label('Area');
  27.   for radius:=1 to maxradius do begin
  28.     rUser1[radius]:=2*3.14159*radius;
  29.     rUser2[radius]:=3.14159*sqr(radius);
  30.   end;
  31.   ShowResults;
  32.   RestoreState;
  33. end;
  34.  
  35.  
  36. macro 'Count Particles at Random Locations';
  37. var
  38.   n,i,width,height,PicID,nLocations:integer;
  39.   size:real;
  40. begin
  41.   RequiresVersion(1.44);
  42.   nLocations:=10;
  43.   size:=0.25;
  44.   n:=1;
  45.   GetPicSize(width,height);
  46.   PicID:=PicNumber;
  47.   SetUser1Label('Count');
  48.   SetOptions('User1');
  49.   for i:=1 to nLocations do begin
  50.     SelectPic(PicID);
  51.     MakeRoi((1-size)*width*random,(1-size)*height*random,size*width,size*height);
  52.     Duplicate('Temp');;
  53.     SetDensitySlice(255,255);
  54.     AnalyzeParticles;
  55.     Dispose;
  56.     rUser1[i]:=rCount;
  57.   end;
  58.   KillRoi;
  59.   SetCounter(nLocations);
  60.   ShowResults;
  61. end;
  62.  
  63.  
  64. macro 'Analyze Particles and Compute Sum';
  65. var
  66.   i:integer;
  67. begin
  68.   AnalyzeParticles;
  69.   SetUser1Label('Sum');
  70.   for i:=1 to rCount do begin
  71.      rUser1[i]:=rMean[i]*rArea[i];
  72.   end;
  73.   UpdateResults;
  74. end;
  75.  
  76.  
  77.  
  78.